home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdKeyboard.mod < prev    next >
Text File  |  1993-08-15  |  21KB  |  669 lines
  1. (*************************************************************************
  2.  
  3. :Program.    EdKeyboard.mod
  4. :Contents.   Keyboard-Routines for Amok-Editor
  5. :Author.     Hartmut Goebel
  6. :Copyright.  Copyright © 1987 by Matthew Dillon
  7. :Copyright.  Oberon implementation Copyright © 1990 by Hartmut Goebel
  8. :Language.   Oberon
  9. :Translator. Amiga Oberon V2.00
  10. :History.    V0.1, 07 Nov 1990 Hartmut Goebel
  11. :History.    V1.0, 14 Apr 1991 Hartmut Goebel [hG]
  12. :History.    V1.1, 25 Apr 1991 [hG] -Bug NKx = KKx, Code optimiert
  13. :History.    V1.1, 25 Apr 1991 [hG] z.T. e.Alloc/FreeMem statt New/Disp.
  14. :History.    V1.1a 24 May 1991 [hG] -SpecKeyCode-Dummy (war Bug in V1.17.1)
  15. :History.    V1.1b 07 Aug 1991 [hG] -Bug in GetCodeQual (-str.Upper(key))
  16. :Date.       30 Aug 1991 20:34:05
  17.  
  18. *************************************************************************)
  19.  
  20. MODULE EdKeyboard;
  21.  
  22. IMPORT
  23.   ASCII,
  24.   e  : Exec,
  25.   con: Console,
  26.   edE: EdErrors,
  27.   edG: EdGlobalVars,
  28.   edL: EdLowLevel,
  29.   ie : InputEvent,
  30.   I  : Intuition,
  31.   ol : OberonLib,
  32.   sl : SupLib,
  33.   str: Strings,
  34.   sys: SYSTEM;
  35.  
  36. CONST
  37.   qualShift = 1; qualCtrl = 2; qualAmiga = 3; qualAlt = 4;
  38.   qualLmb   = 5; qualMmb  = 6; qualRmb   = 7;
  39.  
  40.   Hashsize* = 64 (* was: KeyMap.maxKeys *);
  41.   NumRawKeyCodes = 128; (* lt. ARKM Libs & Devs max. mögl. Raw-Codes *)
  42.   NumDefaultKeys = 60;
  43.   SpecKeyNum = 43;
  44.  
  45.   qMove* = 06BX;
  46.   ReturnRawCode = 44X;
  47.   Return = "return";
  48.   UnknownKey = "Unknown Key";
  49.  
  50. TYPE
  51.   SpecKeyCode = STRUCT
  52.     key: ARRAY 3 OF CHAR;
  53.     code: BYTE;
  54.   END;
  55.   SpecKeyCodeArray = ARRAY SpecKeyNum OF SpecKeyCode;
  56.  
  57.   HashPtr* = POINTER TO Hash;
  58.   Hash* = STRUCT
  59.     next*: HashPtr;
  60.     code*: BYTE;     (* Keycode *)
  61.     (*mask: SHORTSET;  (* qual. mask für was?? *)*)
  62.     qual*: SHORTSET; (* qual. comp *)
  63.     len*: INTEGER;  (* incl. 00C, --> len = 0 für SysMap *)
  64.     map*: edG.StringPtr; (* Command String *)
  65.   END;
  66.  
  67.   DefMapArray = ARRAY NumDefaultKeys OF STRUCT
  68.     from, to: edG.StringPtr;
  69.   END;
  70.  
  71. CONST
  72.   SpecKeyDef = SpecKeyCodeArray(
  73.     "ESC", 0,    "F1",  0,   "F2",  0, (*  0-2  *)
  74.     "F3" , 0,    "F4",  0,   "F5",  0, (*  3-5  *)
  75.     "F6" , 0,    "F7",  0,   "F8",  0, (*  6-8  *)
  76.     "F9" , 0,    "F10", 0,   "DEL", 0, (*  9-11 *)
  77.     "BAC", 0,    "BS",  0,   "TAB", 0, (* 12-14 *)
  78.     "HEL", 0,    "RET", 44X, "UP",  0, (* 15-17 *)
  79.     "DOW", 0,    "RIG", 0,   "LEF", 0, (* 18-20 *)
  80.     "ENT", 43X,  "NK-", 0,   "NK.", 0, (* 21-23 *)
  81.     "NK0", 0,                          (* 24    *)
  82.     "NK1", 0,    "NK2", 0,   "NK3", 0, (* 25-27 *)
  83.     "NK4", 0,    "NK5", 0,   "NK6", 0, (* 28-30 *)
  84.     "NK7", 0,    "NK8", 0,   "NK9", 0, (* 31-33 *)
  85.     "NK(", 0,    "NK)", 0,   "NK/", 0, (* 34-36 *)
  86.     "NK*", 0,    "NK+", 0,             (* 37-38 *)
  87.     "LMB", 068X, "MMB", 06AX,          (* 39-40 *)
  88.     "RMB", 069X, "MMO", qMove);        (* 41-42 *)
  89.  
  90.   DefaultMap = DefMapArray(
  91.     sys.ADR("up"),      sys.ADR("up"),
  92.     sys.ADR("c-esc"),   sys.ADR("recall"),
  93.     sys.ADR("return"),  sys.ADR("return"),
  94.     sys.ADR("enter"),   sys.ADR("return"),
  95.     sys.ADR("esc"),     sys.ADR("esc"),
  96.     sys.ADR("down"),    sys.ADR("down"),
  97.     sys.ADR("right"),   sys.ADR("right"),
  98.     sys.ADR("left"),    sys.ADR("left"),
  99.     sys.ADR("bs"),      sys.ADR("bs"),
  100.     sys.ADR("del"),     sys.ADR("del"),
  101.     sys.ADR("tab"),     sys.ADR("tab"),
  102.     sys.ADR("a-up"),    sys.ADR("scrollup"),
  103.     sys.ADR("a-down"),  sys.ADR("scrolldown"),
  104.     sys.ADR("a-r"),     sys.ADR("nextr"),
  105.     sys.ADR("a-u"),     sys.ADR("while cl (tlate -32 right)"),
  106.     sys.ADR("a-l"),     sys.ADR("while cu (tlate +32 right)"),
  107.     sys.ADR("s-up"),    sys.ADR("top"),
  108.     sys.ADR("s-down"),  sys.ADR("bottom"),
  109.     sys.ADR("s-right"), sys.ADR("last"),
  110.     sys.ADR("s-left"),  sys.ADR("first"),
  111.     sys.ADR("s-tab"),   sys.ADR("backtab"),
  112.     sys.ADR("s-del"),   sys.ADR("deline"),
  113.     sys.ADR("s- "),     sys.ADR("( )"),        (* shift space to space *)
  114.     sys.ADR("c-1"),     sys.ADR("goto block"),
  115.     sys.ADR("c-c"),     sys.ADR(""),           (* break.. map to a nop *)
  116.     sys.ADR("c-l"),     sys.ADR("wleft"),
  117.     sys.ADR("c-r"),     sys.ADR("wright"),
  118.     sys.ADR("c-i"),     sys.ADR("insertmode on"),
  119.     sys.ADR("c-o"),     sys.ADR("insertmode off"),
  120.     sys.ADR("c-j"),     sys.ADR("join"),
  121.     sys.ADR("c-s"),     sys.ADR("split first down"),
  122.     sys.ADR("c-del"),   sys.ADR("remeol"),
  123.     sys.ADR("c-n"),     sys.ADR("next"),
  124.     sys.ADR("c-p"),     sys.ADR("prev"),
  125.     sys.ADR("c-/"),     sys.ADR("escimm (find )"),
  126.     (*sys.ADR("c-]"),     sys.ADR("ref"),*)
  127.     (*sys.ADR("c-["),     sys.ADR("ctags"),*)
  128.     sys.ADR("c-g"),     sys.ADR("escimm (goto )"),
  129.     sys.ADR("c-up"),    sys.ADR("pageup"),
  130.     sys.ADR("c-down"),  sys.ADR("pagedown"),
  131.     sys.ADR("c-q"),     sys.ADR("quit"),
  132.     sys.ADR("c-f"),     sys.ADR("reformat"),
  133.     sys.ADR("c-w"),     sys.ADR("toggle wordwrap"),
  134.     sys.ADR("f1"),      sys.ADR("escimm (insfile )"),
  135.     sys.ADR("f2"),      sys.ADR("escimm (newfile )"),
  136.     sys.ADR("f3"),      sys.ADR("escimm (newwindow newfile)"),
  137.     sys.ADR("f6"),      sys.ADR("saveold iconify"),
  138.     sys.ADR("f7"),      sys.ADR("escimm (bsave )"),
  139.     sys.ADR("f8"),      sys.ADR("saveold escimm (newfile )"),
  140.     sys.ADR("f9"),      sys.ADR("saveold"),
  141.     sys.ADR("f10"),     sys.ADR("saveold quit"),
  142.     sys.ADR("c-b"),     sys.ADR("block"),
  143.     sys.ADR("c-u"),     sys.ADR("unblock"),
  144.     sys.ADR("a-d"),     sys.ADR("bdelete"),
  145.     sys.ADR("a-c"),     sys.ADR("bcopy"),
  146.     sys.ADR("a-m"),     sys.ADR("bmove"),
  147.     sys.ADR("a-s"),     sys.ADR("bsource"),
  148.     sys.ADR("a-S"),     sys.ADR("unblock block block bsource"),
  149.     sys.ADR("L-lmb"),   sys.ADR("tomouse"), (* left button *)
  150.     sys.ADR("L-mmo"),   sys.ADR("tomouse"), (* mouse move with left held down *)
  151.     sys.ADR("R-rmb"),   sys.ADR("iconify"), (* right button *)
  152.     sys.ADR("a-("),     sys.ADR("`:-)'"));  (* Smily *)
  153.  
  154. VAR
  155.   HashList*: ARRAY Hashsize OF HashPtr;
  156.   cTOa:  ARRAY NumRawKeyCodes OF CHAR;
  157.   csTOa: ARRAY NumRawKeyCodes OF CHAR;
  158.   SpecKey: POINTER TO SpecKeyCodeArray;
  159.   RetOvrString: edG.StringPtr; (* Zwischenspeicher für *)
  160.   RetOvrLen: INTEGER;       (* PROC ReturnOveride *)
  161.   cqTOaBuffer: ARRAY 16 OF CHAR;
  162.  
  163.  
  164. (* Ermittelt aus Raw-code und qualifiern einen String, der die Taste  *)
  165. (* in der Form `qual-Key' beschreibt (Umkehrfunktion von GetCodeQual) *)
  166.  
  167. PROCEDURE cqTOa*(code: BYTE; qual: SHORTSET): edG.StringPtr;
  168. VAR
  169.   i,j: INTEGER;
  170. BEGIN
  171.   i := 0;
  172.   IF qualShift IN qual THEN cqTOaBuffer[i] := "s"; INC(i); END;
  173.   IF qualCtrl  IN qual THEN cqTOaBuffer[i] := "c"; INC(i); END;
  174.   IF qualAlt   IN qual THEN cqTOaBuffer[i] := "a"; INC(i); END;
  175.   IF qualAmiga IN qual THEN cqTOaBuffer[i] := "A"; INC(i); END;
  176.   IF qualLmb   IN qual THEN cqTOaBuffer[i] := "L"; INC(i); END;
  177.   IF qualMmb   IN qual THEN cqTOaBuffer[i] := "M"; INC(i); END;
  178.   IF qualRmb   IN qual THEN cqTOaBuffer[i] := "R"; INC(i); END;
  179.   cqTOaBuffer[i] := "-"; INC(i);
  180.   j := 0;
  181.   LOOP
  182.     IF SpecKey[j].code = code THEN          (* Sondertaste? *)
  183.       cqTOaBuffer[i] := SpecKey[j].key[0];
  184.       cqTOaBuffer[i+1] := SpecKey[j].key[1];
  185.       cqTOaBuffer[i+2] := SpecKey[j].key[2];
  186.       INC(i,3);
  187.       EXIT;
  188.     END;
  189.     INC(j);
  190.     IF j = SpecKeyNum THEN                  (* Normale Taste *)
  191.       cqTOaBuffer[i] := cTOa[ORD(code)];
  192.       INC(i);
  193.       EXIT;
  194.     END;
  195.   END;
  196.   cqTOaBuffer[i] := 0X;
  197.   RETURN sys.ADR(cqTOaBuffer);
  198. END cqTOa;
  199.  
  200.  
  201. (* Ermittelt aus einem String, der die Taste in der Form `qual-Key' *)
  202. (* beschreibt, Rawcode und qualifier (Umkehrfunktion von cqTOa)     *)
  203.  
  204. PROCEDURE GetCodeQual(key: edG.StringPtr;
  205.                       VAR code: BYTE; VAR qual: SHORTSET): BOOLEAN;
  206. (* key : zu untersuchender String, z.B. "s-d"
  207.    code: Tastaturcode, qual: Qualifiers
  208. *)
  209. VAR
  210.   i, j, len: INTEGER;
  211.   help : ARRAY 3 OF CHAR;
  212. BEGIN
  213.   i := 0;
  214.   qual := SHORTSET{};
  215.   len := str.Length(key^);
  216.   IF len > 1 THEN
  217.     WHILE (i < len) AND (key[i] # "-") DO
  218.       INC(i); END;
  219.     j := i;
  220.     WHILE j > 0 DO
  221.       DEC(j);
  222.       CASE key[j] OF
  223.       |"s" : INCL(qual,qualShift);
  224.       |"c" : INCL(qual,qualCtrl);
  225.       |"a" : INCL(qual,qualAlt);
  226.       |"A" : INCL(qual,qualAmiga);
  227.       |"L" : INCL(qual,qualLmb);
  228.       |"M" : INCL(qual,qualMmb);
  229.       |"R" : INCL(qual,qualRmb);
  230.       ELSE
  231.         qual := SHORTSET{};
  232.         j := i;
  233.         i := 0;
  234.       END;
  235.     END; (* WHILE *)
  236.     IF key[i] = "-" THEN INC(i); END;
  237.   END; (* len > 1 *)
  238.   IF len > i+1 THEN           (* long name : more than this Byte left  *)
  239.     help[0] := CAP(key[i]);   (* nicht schoen, aber sicher *)
  240.     help[1] := CAP(key[i+1]); (* eine kurze Möglichkeit    *)
  241.     help[2] := CAP(key[i+2]);
  242.     i := SpecKeyNum;
  243.     REPEAT                      (* entsprechenden Rawcode suchen *)
  244.       DEC(i);
  245.       IF help = SpecKey[i].key THEN
  246.         code := SpecKey[i].code;
  247.         RETURN TRUE;
  248.       END;
  249.     UNTIL i = 0;
  250.   ELSIF len = i+1 THEN                 (* single character keycap *)
  251.     j := 0;            (* wichtig: von 0 aufwärts suchen, wg. NKx *)
  252.     REPEAT
  253.       IF key[i] = cTOa[j] THEN   (* ohne Shift *)
  254.         code := SHORT(j);
  255.         RETURN TRUE;
  256.       END;
  257.       INC(j);
  258.     UNTIL j = NumRawKeyCodes;
  259.     j := 0;
  260.     REPEAT
  261.       IF key[i] = csTOa[j] THEN  (* mit Shift *)
  262.         code := SHORT(j);
  263.         INCL(qual,qualShift);
  264.         RETURN TRUE;
  265.       END;
  266.       INC(j);
  267.     UNTIL j = NumRawKeyCodes;
  268.   END; (* IF len > i *)
  269.   RETURN FALSE;
  270. END GetCodeQual;
  271.  
  272.  
  273. (* Fügt einen String als Tastaturbelegung der mit code & qual angegebenen *)
  274. (* Taste in die Tasaturbelegung (Hash!!) ein. Die Hash wird aus           *)
  275. (* (Rawcode AND 64) gebildet, und alle Tastaturbelegungen mit dieser Hash *)
  276. (* an eine Kette gehängt.                                                 *)
  277.  
  278. PROCEDURE AddHash(code: BYTE; (*mask,*) qual:SHORTSET;
  279.                   map: edG.StringPtr; sysMap: BOOLEAN);
  280. VAR
  281.   thisHash: HashPtr;
  282.   hPtr: POINTER TO HashPtr;
  283.   HashValue: INTEGER;
  284. BEGIN
  285.   HashValue := ORD(code) MOD Hashsize;
  286.   thisHash := HashList[HashValue];
  287.   hPtr := sys.ADR(HashList[HashValue]);
  288.   LOOP
  289.     IF thisHash = NIL THEN  (* noch nicht belegt, einrichten *)
  290.       thisHash := e.AllocMem(sys.SIZE(Hash),LONGSET{e.memClear});
  291.       IF thisHash=NIL THEN
  292.         INCL (edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
  293.         RETURN;
  294.       END;
  295.       hPtr^ := thisHash;
  296.       thisHash.next := NIL;
  297.       thisHash.code := code;
  298.       (*thisHash.mask := mask;*)
  299.       thisHash.qual := qual;
  300.       EXIT;
  301.     END;
  302.     IF (thisHash.code = code) AND     (* richtige Taste? *)
  303.        (*(thisHash.mask = mask) AND*)
  304.        (thisHash.qual = qual) THEN
  305.       (* Sysmap-Keys dürfen nicht DISPOSEd werden *)
  306.       IF thisHash.len # 0 THEN        (* vom User belegt? *)
  307.         DISPOSE(thisHash.map); END;   (* löschen *)
  308.       EXIT;
  309.     END;
  310.     hPtr := sys.ADR(thisHash.next);
  311.     thisHash := thisHash.next;
  312.   END; (* LOOP *)
  313.   IF NOT sysMap THEN
  314.     thisHash.map := edL.CopyString(map);
  315.     thisHash.len := str.Length(map^);
  316.   ELSE
  317.     thisHash.map := map; (* SysMap *)
  318.     thisHash.len := 0;
  319.   END;
  320. END AddHash;
  321.  
  322.  
  323. PROCEDURE RemHash(code: BYTE; (*mask,*) qual: SHORTSET);
  324. VAR
  325.   thisHash, hnext,hlast: HashPtr;
  326.   HashValue: INTEGER;
  327. BEGIN
  328.   HashValue := ORD(code) MOD Hashsize;
  329.   thisHash := HashList[HashValue];
  330.   WHILE thisHash # NIL DO
  331.     hnext := thisHash.next;
  332.     IF (thisHash.code = code) (*AND (thisHash.mask = mask)*)
  333.     AND (thisHash.qual = qual) THEN
  334.       IF thisHash.len # 0 THEN
  335.         DISPOSE(thisHash.map);
  336.       END;
  337.       IF thisHash = HashList[HashValue] THEN
  338.         HashList[HashValue] := thisHash.next;
  339.       ELSE
  340.         hlast.next := thisHash.next;
  341.       END;
  342.       e.FreeMem(thisHash,sys.SIZE(Hash));
  343.       RETURN;
  344.     END;
  345.     hlast := thisHash;
  346.     thisHash := hnext;
  347.   END;
  348. END RemHash;
  349.  
  350.  
  351. (* Löscht die komplette Tastatur Hash => Tastaturbelegung ist weg *)
  352.  
  353. PROCEDURE DeallocHash*;
  354. VAR
  355.  thisHash, hnext: HashPtr;
  356.  i: SHORTINT;
  357. BEGIN
  358.   i := Hashsize;
  359.   REPEAT
  360.     DEC(i);
  361.     thisHash := HashList[i];
  362.     WHILE thisHash # NIL DO
  363.       hnext := thisHash.next;
  364.       IF thisHash.len # 0 THEN DISPOSE(thisHash.map); END;
  365.       e.FreeMem(thisHash,sys.SIZE(Hash));
  366.       thisHash := hnext;
  367.     END;
  368.     HashList[i] := NIL;
  369.   UNTIL i = 0;
  370. END DeallocHash;
  371.  
  372.  
  373. (* Stellt die Default-Belegung für die Tasten her *)
  374.  
  375. PROCEDURE ResetHash*;
  376. VAR
  377.   i: INTEGER;
  378.   code: BYTE;
  379.   qual: SHORTSET;
  380. BEGIN
  381.   DeallocHash;
  382.   i := NumDefaultKeys;
  383.   REPEAT
  384.     DEC(i);
  385.     IF GetCodeQual(DefaultMap[i].from,code,qual) THEN
  386.       AddHash(code,(*sys.VAL(SHORTSET,0FFX),*)qual,DefaultMap[i].to,TRUE);
  387.       IF edG.memoryFail IN edG.Status THEN RETURN END;
  388.     END;
  389.   UNTIL i=0;
  390. END ResetHash;
  391.  
  392.  
  393. (* gibt die Adresse des String zurück, mit dem einem Key in der Form *)
  394. (* `qual-Key' belegt ist *)
  395.  
  396. PROCEDURE KeySpectroMacro*(string: edG.StringPtr): edG.StringPtr;
  397.  
  398. VAR
  399.   thisHash: HashPtr;
  400.   code: BYTE;
  401.   qual: SHORTSET;
  402. BEGIN
  403.   IF GetCodeQual(string,code,qual) THEN
  404.     thisHash := HashList[ORD(code) MOD Hashsize];
  405.     WHILE thisHash # NIL DO
  406.       IF (thisHash.code = code)
  407.       AND (thisHash.qual = (qual (** thisHash.mask*))) THEN
  408.         RETURN thisHash.map;
  409.       END;
  410.       thisHash := thisHash.next;
  411.     END; (* WHILE *)
  412.   END;
  413.   RETURN NIL;
  414. END KeySpectroMacro;
  415.  
  416.  
  417. (* belegt den Key in der Form `qual-Key' mit edG.Arg[1] *)
  418.  
  419. PROCEDURE doMap*;
  420. VAR
  421.   code: CHAR;
  422.   qual: SHORTSET;
  423. BEGIN
  424.   IF GetCodeQual(edG.Arg[0],code,qual) THEN       (* code und qual suchen *)
  425.     AddHash(code,(*sys.VAL(SHORTSET,0FFX),*)qual,edG.Arg[1],FALSE);
  426.   ELSE
  427.     edG.Rc := edE.cmdError; edL.Title(UnknownKey);
  428.   END;
  429. END doMap;
  430.  
  431.  
  432. (* löscht die Belegung des Key's in der Form `qual-Key' *)
  433.  
  434. PROCEDURE doUnmap*;
  435. VAR
  436.   code: CHAR;
  437.   qual: SHORTSET;
  438. BEGIN
  439.   IF GetCodeQual(edG.Arg[0],code,qual) THEN     (* code und qual suchen *)
  440.     RemHash(code,(*sys.VAL(SHORTSET,0FFX),*)qual);  (* löschen *)
  441.   ELSE
  442.     edG.Rc := edE.cmdError; edL.Title(UnknownKey);
  443.   END;
  444. END doUnmap;
  445.  
  446. (* ermittelt für Raw-Codes 0..127, um welche Taste es sich handelt *)
  447.  
  448. PROCEDURE KeyboardInit*;
  449. VAR
  450.   i, len: INTEGER;
  451.   iEvent: ie.InputEventAdr;
  452.   buffer: ARRAY 32 OF CHAR;
  453.   qual: SHORTSET;
  454. BEGIN
  455.   iEvent.nextEvent := NIL;
  456.   iEvent.class := ie.rawkey;
  457.   iEvent.subClass := 0;
  458.   i := NumRawKeyCodes;
  459.   REPEAT
  460.     DEC(i);
  461.     iEvent.code := i;
  462.     iEvent.qualifier := {};
  463.     iEvent.addr := NIL;
  464.     len := SHORT(con.RawKeyConvert(sys.ADR(iEvent),buffer,
  465.                                    sys.SIZE(buffer),NIL));
  466.  (* this first part is quiet dirty: changing consts (Bad!!). But it should *)
  467.  (* not matter, cause they are only depenting on the Keymaping. So every   *)
  468.  (* call from a Process/Task using Std_Keymap gives the _same_ result.     *)
  469.     CASE len OF
  470.      1: IF (buffer[0] >= CHR(32)) AND (buffer[0] < CHR(127)) THEN
  471.           cTOa[i] := buffer[0];
  472.         END;
  473.         CASE buffer[0] OF  (* esc/del/tab/bs/nkx *)
  474.          1BX: SpecKey[ 0].code := CHR(i);
  475.         |7FX: SpecKey[11].code := CHR(i);
  476.         |09X: SpecKey[14].code := CHR(i);
  477.         |08X: SpecKey[12].code := CHR(i); SpecKey[13].code := CHR(i);
  478.         |"-": IF (i > 3AH) THEN SpecKey[22].code := CHR(i); END;
  479.         |".": IF (i > 3AH) THEN SpecKey[23].code := CHR(i); END;
  480.         |"(": IF (i > 3AH) THEN SpecKey[34].code := CHR(i); END;
  481.         |")": IF (i > 3AH) THEN SpecKey[35].code := CHR(i); END;
  482.         |"/": IF (i > 3AH) THEN SpecKey[36].code := CHR(i); END;
  483.         |"*": IF (i > 3AH) THEN SpecKey[37].code := CHR(i); END;
  484.         |"+": IF (i > 3AH) THEN SpecKey[38].code := CHR(i); END;
  485.         ELSE
  486.           IF (buffer[0] <= "9") AND (buffer[0] >= "0") AND (i >= 0FH) THEN
  487.             SpecKey[ORD(buffer[0])+(24-ORD("0"))].code := CHR(i);   (* nkn *)
  488.           END;
  489.         END; (* CASE buffer[0] *)
  490.     |2: IF buffer[0] = ASCII.csi THEN   (* cursor *)
  491.            CASE (buffer[1]) OF
  492.              "A": SpecKey[17].code := CHR(i); |
  493.              "B": SpecKey[18].code := CHR(i); |
  494.              "C": SpecKey[19].code := CHR(i); |
  495.              "D": SpecKey[20].code := CHR(i);
  496.            ELSE;
  497.            END;
  498.         END;
  499.     |3: IF (buffer[0] = ASCII.csi) AND (buffer[2] = 7EX) THEN (* funct/help *)
  500.           IF (buffer[1] >= "0") AND (buffer[1] <= "9") THEN
  501.             SpecKey[ORD(buffer[1])-(ORD("0")-1)].code := CHR(i);
  502.           ELSIF buffer[1] = "?" THEN
  503.             SpecKey[15].code := CHR(i);
  504.           END;
  505.         END;
  506.     ELSE;
  507.     END; (* CASE len *)
  508.   UNTIL i = 0;
  509.   i := NumRawKeyCodes;
  510.   REPEAT
  511.     DEC(i);
  512.     iEvent.code := i;
  513.     iEvent.qualifier := {ie.lShift};
  514.     iEvent.addr := NIL;
  515.     len := SHORT(con.RawKeyConvert(sys.ADR(iEvent),buffer,
  516.                                    sys.SIZE(buffer),NIL));
  517.     IF len = 1 THEN csTOa[i] := buffer[0]; END;
  518.   UNTIL i = 0;
  519.   IF GetCodeQual(sys.ADR("c"),edG.CtrlC,qual) THEN END;
  520. END KeyboardInit;
  521.  
  522.  
  523. (* überschreibt '-return' mit return bzw. (ggf. vorher gespeicherter) *)
  524. (* alter belegung *)
  525.  
  526. PROCEDURE ReturnOveride*(overide: BOOLEAN);
  527. VAR
  528.   thisHash: HashPtr;
  529. BEGIN
  530.   thisHash := HashList[44H MOD Hashsize];
  531.   WHILE thisHash # NIL DO
  532.     IF (thisHash.code = ReturnRawCode) AND
  533.        (thisHash.qual = SHORTSET{}) THEN    (* schon belegt *)
  534.       IF overide THEN
  535.         RetOvrString := thisHash.map;
  536.         RetOvrLen := thisHash.len;
  537.         thisHash.map := sys.ADR(Return);
  538.         thisHash.len := 0;
  539.       ELSE
  540.         IF RetOvrString = NIL THEN
  541.           RemHash(ReturnRawCode,(*sys.VAL(SHORTSET,0FFX),*)SHORTSET{});
  542.         ELSE
  543.           thisHash.map := RetOvrString;
  544.           thisHash.len := RetOvrLen;
  545.         END;
  546.       END;
  547.       RETURN;
  548.     END;
  549.     thisHash := thisHash.next;
  550.   END;
  551.   IF overide THEN                      (* noch nicht belgt *)
  552.     AddHash(ReturnRawCode,(*sys.VAL(SHORTSET,0FFX),*)SHORTSET{},
  553.             sys.ADR(Return),TRUE);
  554.     RetOvrString := NIL;
  555.   END;
  556. END ReturnOveride;
  557.  
  558.  
  559. PROCEDURE GetKeyText*(imsg: I.IntuiMessagePtr;
  560.                       code: BYTE; qual: SET; VAR buffer: edG.String): INTEGER;
  561. VAR
  562.   thisHash: HashPtr;
  563.   q2: SHORTSET;
  564.   blen,i: INTEGER;
  565.   bufPtr: edG.StringPtr;
  566. BEGIN
  567.   blen := 0;
  568.   IF imsg # NIL THEN
  569.     IF NOT (edG.kick20 IN edG.Status) THEN
  570.       EXCL(imsg.qualifier,ie.repeat); END;
  571.     bufPtr := sys.ADR(buffer[1]);
  572.     blen := SHORT(sl.DeadKeyConvert(imsg,bufPtr^,edG.MaxLineLength-2,NIL));
  573.     IF blen <= 0 THEN RETURN -1; END;
  574.   END; (* imsg # NIL *)
  575.  
  576.   q2 := SHORTSET{};                 (* Qualifiers herausfinden *)
  577.   IF (qual * {ie.lCommand,ie.rCommand})#{} THEN INCL(q2,qualAmiga); END;
  578.   IF (qual * {ie.lShift,ie.rShift})#{} THEN INCL(q2,qualShift); END;
  579.   IF (qual * {ie.lAlt,  ie.rAlt})  #{} THEN INCL(q2,qualAlt); END;
  580.   IF ie.control     IN qual THEN INCL(q2,qualCtrl); END;
  581.   IF ie.leftButton  IN qual THEN INCL(q2,qualLmb); END;
  582.   IF ie.midButton   IN qual THEN INCL(q2,qualMmb); END;
  583.   IF ie.rightButton IN qual THEN INCL(q2,qualRmb); END;
  584.   IF (ie.capsLock IN qual) AND (blen = 1)
  585.   AND (buffer[1] >= "a") AND (buffer[1] <= "z") THEN
  586.     INCL(q2,qualShift); END;
  587.   code := CHR(ORD(code) MOD NumRawKeyCodes);
  588.  
  589.   IF edG.numLock IN edG.Status THEN
  590.     i := 23; (* auf nk. *)
  591.     REPEAT
  592.       IF SpecKey[i].code = code THEN
  593.         buffer[0] := "'"; buffer[1] := SpecKey[i].key[2]; buffer[2] := 0X;
  594.         RETURN 1;
  595.       END;
  596.       INC(i);
  597.     UNTIL i > 33; (* hinter nk9 *)
  598.   END;
  599.   thisHash := HashList[ORD(code) MOD Hashsize];
  600.   LOOP
  601.     IF thisHash = NIL THEN EXIT; END;  (* Taste belegt? *)
  602.     IF (thisHash.code = code)
  603.     AND (q2 (* * thisHash.mask*) = thisHash.qual) THEN
  604.       EXIT; END;
  605.     thisHash := thisHash.next;
  606.   END;
  607.  
  608.     (* use HashList entry only if not in commandline or if the entry *)
  609.     (* does not correspont to an alpha key *)
  610.  
  611.   IF thisHash # NIL THEN   (* Taste belegt! *)
  612.     IF (q2 # SHORTSET{}) OR NOT (edG.commLineMode IN edG.Status)
  613.     OR (blen>1) OR (cTOa[ORD(code)] = 0X) THEN
  614.       blen := str.Length(thisHash.map^);
  615.       e.CopyMem(thisHash.map^,buffer,blen+1);
  616.     END;
  617.   ELSIF blen = 1 THEN  (* einzelnes Zeichen *)
  618.     buffer[0] := "'";
  619.     buffer[2] := 0X;
  620.   ELSIF buffer[1] # ASCII.csi THEN (* keine Sondertaste *)
  621.     buffer[0] := "`";
  622.     buffer[blen+1] := "'";
  623.     buffer[blen+2] := 0X;
  624.   ELSE
  625.     buffer[0] := 0X;
  626.   END;
  627.   RETURN blen;
  628. END GetKeyText;
  629.  
  630. (*-----------------------------------------------------------------------
  631.  * folgende beiden Prozeduren sind zum Debuggen. Es brauchen nur zwei
  632.  * Befehle eingebunden zu werden, die diese beiden Proc. ohne Parameter
  633.  * aufrufen.
  634.  * GetHash: zeigt alle Belegungen zu einem Raw-Key-Value
  635.  * GetMap:  zeigt die Belegung einer Taste (Eingabe wie bei Map)
  636. PROCEDURE doGetMap*;
  637.   BEGIN
  638.     edG.Arg[1] := KeySpectroMacro(edG.Arg[0]);
  639.     edL.Title(edG.Arg[1]^);
  640.   END doGetMap;
  641. PROCEDURE doGetHash*;
  642.   VAR text: edG.StringPtr;
  643.     thisHash : HashPtr;
  644.     code : LONGINT;
  645.   BEGIN
  646.     IF edL.StrToInt(Key,code) THEN
  647.       thisHash := HashList[code MOD Hashsize];
  648.       WHILE thisHash # NIL DO
  649.         IF thisHash.code = sys.VAL(BYTE,SHORT(SHORT(code))) THEN
  650.           edL.Title(thisHash.map^); END;
  651.         thisHash := thisHash.next;
  652.       END; (* WHILE *)
  653.     END;
  654.   END doGetHash;
  655. *)
  656.  
  657. BEGIN
  658.   (*RetOvrStr := NIL; RetOvrLen := 0;*)
  659.   SpecKey := sys.ADR(SpecKeyDef);
  660.   KeyboardInit; (* MainPort muß! bereits geöffnet sein *)
  661.   ResetHash;
  662.   IF edG.memoryFail IN edG.Status THEN HALT(20); END;
  663. CLOSE
  664.   (*DISPOSE(RetOvrString); (* nicht erst über ReturnOveride(FALSE) *)*)
  665.   ReturnOveride(FALSE);
  666.   DeallocHash;
  667. END EdKeyboard.
  668.  
  669.